logo

This script generates plots comparing grassland bird population trends in Crow-Hassan park with regional trends from the BBS.

Setup

Load packages & data

knitr::opts_chunk$set(echo = TRUE)
library(here)
library(tidyverse)
library(auk)

source(here("Scripts", "1_Data_Import.R"))
# source(here("Scripts", "2_Spatial_Data_Import.R"))
# source(here("Scripts", "3_Data_Cleaning.R"))
# source(here("Scripts", "4_Covariate_Data_Prep.R"))
source(here("Scripts", "5_Prep_Species.R"))

Define inputs and outputs

# Which park estimates to use? Defined using the tag used to run the bird_trends_species script.
tag_chbbs <- "20231128_plus1_to_counts"

# Which regional estimates to use?
BBS_indices <- readRDS(here("Results", "993_BBS_fromCWS", "Indices", "00_all_sp_MN23.RDS"))
BBS_trends <- read_csv(here("Data", "Wildlife", "BBS", "BBS_CWS", "All_2021_BBS_trends.csv")) %>%
  filter(Region == "US-MN-23")

# Create directory to save outputs
mainDir <- here("Results", "979_BBS_CHBB_comparison")
dir.create(file.path(mainDir, tag_chbbs), showWarnings = TRUE)
outputDir <- here("Results", "979_BBS_CHBB_comparison", tag_chbbs)
subdirectories <- c("Plots")
lapply(file.path(mainDir, tag_chbbs, subdirectories), function(x) if (!dir.exists(x)) dir.create(x))

Prepare data

Prepare park data

# Load park abundance estimates
chbbs_ests <- list.files(here("Results", "991_bird_trends_species", tag_chbbs, "annual_n_estimates"), pattern = "annual_N_ests.csv", full.names = TRUE)
chbbs_ests <- lapply(chbbs_ests, read_csv)
chbbs_ests_names <- list.files(here("Results", "991_bird_trends_species", tag_chbbs, "annual_n_estimates"), pattern = "annual_N_ests.csv", full.names = FALSE)
chbbs_ests_names <- gsub(pattern = "_annual_N_ests.csv", replacement = "", x = chbbs_ests_names)
names(chbbs_ests) <- chbbs_ests_names
chbbs_ests <- bind_rows(chbbs_ests, .id = "sp") %>%
  select(sp, year, N_est_mean, N_est_LCI_95, N_est_UCI_95) %>%
  rename(
    Year = year,
    Index = N_est_mean,
    Index_q_0.025 = N_est_LCI_95,
    Index_q_0.975 = N_est_UCI_95
  ) %>%
  mutate(source = "chbbs")

# join eBird taxonomy and get list of park species
chbbs_ests <- chbbs_ests %>%
  left_join(bird.tblBirdSpecies.ebird %>% select(BirdCode, common_name, scientific_name, taxon_order), by = c("sp" = "BirdCode")) %>%
  mutate(species = common_name)
sp_chbbs <- unique(chbbs_ests$common_name)

Prepare regional (BBS) data

# Load regional abundance estimates
bbs_ests <- BBS_indices %>%
  mutate(source = "bbs")

# Get list of regional species
sp_bbs <- unique(bbs_ests$species)

Combine datasets

dat <- bind_rows(chbbs_ests, bbs_ests) %>%
  mutate(source = factor(source, levels = c("chbbs", "bbs")))

adjust_chbbs_by_1 <- TRUE

if (adjust_chbbs_by_1) {
  dat2 <- dat %>%
    mutate(
      Index_q_0.025 = ifelse(source == "chbbs", Index_q_0.025 - 1, Index_q_0.025),
      Index_q_0.975 = ifelse(source == "chbbs", Index_q_0.975 - 1, Index_q_0.975),
      Index = ifelse(source == "chbbs", Index - 1, Index)
    ) %>%
    mutate(
      Index_q_0.025 = ifelse(Index_q_0.025 < 0, 0, Index_q_0.025),
      Index_q_0.975 = ifelse(Index_q_0.975 < 0, 0, Index_q_0.975),
      Index = ifelse(Index < 0, 0, Index)
    )
} else {
  dat2 <- dat
}

sp_shared <- intersect(sp_bbs, sp_chbbs)

# Note species not found in one dataset or the other
# (sp_not_in_chbbs <- setdiff(sp_bbs, sp_chbbs)) # species in bbs but not chbbs
# (sp_not_in_bbs <- setdiff(sp_chbbs, sp_bbs)) # species in chbbs but not bbs

Time-series comparison plots

Generate plots

generate_comp_plots <- function(focal_species) {
  # Annual estimate plots
  plot_chbbs_prop <- dat2 %>%
    filter(species == focal_species) %>%
    ggplot() +
    ggthemes::theme_wsj(color = "grey") +
    geom_ribbon(aes(x = Year, ymin = Index_q_0.025, ymax = Index_q_0.975, fill = source), alpha = 0.2) +
    geom_line(aes(x = Year, y = Index, color = source, group = source)) +
    geom_point(aes(x = Year, y = Index, color = source)) +
    scale_color_manual(values = c("#24537D", "#5f9a90")) +
    scale_fill_manual(values = c("#24537D", "#5f9a90")) +
    facet_wrap(~source,
      scales = "free_y", strip.position = "top", ncol = 1,
      labeller = as_labeller(c(chbbs = "Total count (TRPD Prairie Transects)", bbs = "Mean count per route (MN-23 Breeding Bird Survey)"))
    ) +
    ylab(NULL) +
    theme(
      strip.background = element_blank(),
      strip.placement = "outside",
      strip.text = element_text(hjust = 0, face = "italic", size = 10),
      axis.text = element_text(face = "bold", size = 10),
      plot.title = element_text(face = "bold", size = 12, family = NA),
      legend.position = "none"
    ) +
    labs()

  # Percent change plot
  # This calculates percent change in Index relative to the first shared year between the two data sets for each species
  plot_percent_change <- dat %>%
    filter(species == focal_species) %>%
    group_by(species) %>%
    # Find the first shared year between Methods for each species
    mutate(First_Shared_Year = min(intersect(Year[source == "bbs"], Year[source == "chbbs"]))) %>%
    ungroup() %>%
    group_by(species, source) %>%
    # Calculate percent change relative to the first shared year
    mutate(Percent_Change = (Index - Index[Year == First_Shared_Year]) / Index[Year == First_Shared_Year] * 100) %>%
    # Plot data
    ggplot() +
    ggthemes::theme_wsj(color = "grey") +
    ggthemes::scale_color_wsj() +
    geom_hline(yintercept = 0, color = "black", linewidth = 1.2, alpha = .5) +
    geom_point(aes(x = Year, y = Percent_Change, color = source)) +
    geom_line(aes(x = Year, y = Percent_Change, color = source, group = source)) +
    facet_wrap(~species, scales = "free_y", strip.position = "top") +
    scale_y_continuous(labels = function(x) paste0(x, "%")) +
    scale_color_manual(values = c("#24537D", "#5f9a90")) +
    scale_fill_manual(values = c("#24537D", "#5f9a90")) +
    theme(
      strip.background = element_blank(),
      strip.placement = "outside",
      # strip.text = element_text(hjust = 0, face = "italic", size = 10),
      strip.text = element_blank(),
      axis.text = element_text(face = "bold", size = 10),
      plot.title = element_text(face = "bold", size = 12, family = NA),
      plot.subtitle = element_text(hjust = 0, family = NA, face = "italic", size = 10),
      legend.position = "none"
    ) +
    labs( # title = focal_species,
      subtitle = "Percent change relative to first shared year"
    )

  # Combine plots
  plot_row <- cowplot::plot_grid(plot_chbbs_prop, plot_percent_change)

  # Format and place title
  title <- cowplot::ggdraw() +
    cowplot::draw_label(
      focal_species,
      fontface = "bold",
      x = 0,
      hjust = 0
    ) +
    theme(
      # add margin on the left of the drawing canvas,
      # so title is aligned with left edge of first plot
      plot.margin = margin(0, 0, 0, 7)
    )

  # Layout
  layout <- cowplot::plot_grid(
    title, plot_row,
    ncol = 1,
    # rel_heights values control vertical title margins
    rel_heights = c(0.05, 1)
  )

  # Save plot
  ggsave(filename = paste0(focal_species, "_comp.png"), plot = layout, path = here("Results", "979_BBS_CHBB_comparison", tag_chbbs, "Plots"), width = 9, height = 5)
}

# Apply the function to all shared species
lapply(sp_shared, generate_comp_plots)

View plots

files <- list.files(path = here("Results", "979_BBS_CHBB_comparison", tag_chbbs, "Plots"), pattern = "_comp.png", full.names = TRUE)
files_names <- list.files(path = here("Results", "979_BBS_CHBB_comparison", tag_chbbs, "Plots"), pattern = "_comp.png", full.names = FALSE)
files_names <- gsub("\\_comp.png", "", files_names)

for (i in 1:length(files)) {
  cat(paste0("#### ", files_names[i], "\n"))
  cat(paste0("![](", files[i], ")\n\n"))
}

American Crow

American Goldfinch

Barn Swallow

Blue-winged Teal

Brown-headed Cowbird

Chimney Swift

Clay-colored Sparrow

Common Grackle

Common Yellowthroat

Dickcissel

Eastern Bluebird

Eastern Kingbird

Eastern Meadowlark

Field Sparrow

Grasshopper Sparrow

Henslow’s Sparrow

Horned Lark

House Finch

Killdeer

LeConte’s Sparrow

Mourning Dove

Northern Bobwhite

Northern Cardinal

Northern Harrier

Northern Rough-winged Swallow

Purple Martin

Red-tailed Hawk

Red-winged Blackbird

Ring-necked Pheasant

Sandhill Crane

Savannah Sparrow

Sedge Wren

Song Sparrow

Tree Swallow

Upland Sandpiper

Vesper Sparrow

Western Meadowlark

Willow Flycatcher

 



By Sam Safran